home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / $x < prev    next >
Encoding:
Text File  |  1994-11-06  |  3.0 KB  |  130 lines  |  [TEXT/MSET]
  1. (*
  2.  
  3. Class $x is a dictionary-based simple string class whose length may vary,
  4. up to a maximum of 255, but the maximum length is defined at instantiation.
  5. We cheat a bit here and use Mops' INDEXED class definition abilities and 
  6. indexed ivar data area in a way that was not really intended.  
  7.  
  8. $x's are nice for use as string ivars, or if you want a persistent string
  9. object in the dictionary (no handles here so we don't need to do a new:
  10. and restore the data at each runtime).
  11.  
  12. in class $x we take advantage of the fact that the 2-byte Width field for
  13. indexed objects can be used for other storage *if* we are careful.
  14. Since the Width field is only really needed here at instantiation (we are
  15. careful not to use words that rely on Width actually being the width), we
  16. use it here to store the maximum length, or limit, of text in the $x.
  17. Also, we now use the byte just prior to the indexed data area to store
  18. the length of the text, so it is easy to obtain a str255 format string
  19. since all we need do is obtain this address (which is idxbase - 1 , see
  20. get$: ).
  21.  
  22. Note that there are still 4 unused bytes that might be used for pos and lim
  23. as in string.  I guess we are safe doing this until Michael changes the
  24. internal structure of indexed objects. (!!)
  25.  
  26. *)
  27.  
  28. :class $x super{ object } 1 indexed  \ each character is one byte
  29.     \ at instantiation we simply declare the maximum number of characters desired
  30.  
  31. :m limit:  ( -- lim )
  32.     idxbase 6 - w@ ;m
  33.  
  34. :m get$: \ ( -- $ptr )    \ str255 format
  35.     idxbase 1 - ;m
  36.  
  37. :m size:  \ ( -- len)
  38.     get$: self c@ ;m
  39.  
  40. private        \ private because we should never do this directly
  41.  
  42.     :m setsize:  \ ( len --)
  43.         dup  limit: self > abort" No more room in $x."
  44.         get$: self c!
  45.         ;m
  46. public
  47.  
  48. :m clear:
  49.     0 setsize: self ;m
  50.  
  51. :m classinit:
  52.     limit idxbase 6 - w!    \ this must be the only time we set this
  53.     clear: self ;m
  54.  
  55. :m addr:    \ ( -- addr)  \ redefine to give us the indexed data area
  56.             \ which will be the address of the first character of text
  57.     idxbase ;m
  58.  
  59. :m put:  { addr len -- }
  60.     len setsize: self
  61.     addr  ( src)  addr: self ( dest) len ( cnt) cmove ;m
  62.  
  63. :m get: ( -- addr len )
  64.     addr: self  size: self ;m
  65.  
  66. :m print:
  67.     get: self type ;m
  68.  
  69. :m put$:  { $ptr -- }
  70.     $ptr 1 +  $ptr c@  put: self ;m
  71.  
  72. :m add: { addr len \ $len -- }
  73.     size: self -> $len
  74.     len $len + setsize: self
  75.     addr ( src) addr: self $len +  ( dest) len ( cnt) cmove ;m
  76.  
  77. :m add$: { $ptr -- }
  78.     $ptr 1 +  $ptr c@ add: self ;m
  79.  
  80. :m uc:  ( -- ) \ converts to upper case
  81.     get: self upper ;m
  82.  
  83. :m +:  ( c -- ) \ appends a char to the end of the string
  84.     buf255 c! buf255 1 add: self ;m
  85.  
  86. :m clip:  { n -- }  \ remove n characters from end of string
  87.                     \ if n is too large, string is just cleared with no error
  88.     size: self n - 0 max setsize: self ;m
  89.  
  90. ;class
  91.  
  92. endload
  93.  
  94.  
  95. \ **** EXAMPLE USE
  96.  
  97. 7 $x jj
  98.  
  99. dump: jj
  100.  
  101. print: jj
  102. size: jj .
  103. 3 clip: jj
  104. " hello" put: jj
  105. " ff" add: jj
  106. uc: jj print: jj
  107. 32 +: jj
  108.  
  109. :class test super{ object }
  110.     var junk
  111.     32 $x theString
  112.     var morejunk
  113.  
  114. :m classinit:
  115.     333 put: junk
  116.     " Hello World " put: theString
  117.     666 put: morejunk ;m
  118.  
  119. :m dump:
  120.     get: junk .
  121.     print: theString
  122.     get: morejunk . ;m
  123.  
  124. ;class
  125.  
  126.  
  127. test yy
  128.  
  129. dump: yy
  130.